home *** CD-ROM | disk | FTP | other *** search
/ Aminet 41 / Aminet 41 (2001)(Schatztruhe)[!][Feb 2001].iso / Aminet / gfx / edit / AmiCAD_2.06.lha / AmiCAD / ARexx / SelectNet.AmiCAD < prev    next >
Text File  |  2000-04-14  |  4KB  |  202 lines
  1. /* Sélection d'une netlist */
  2. /* Version 1.00 (14-07-98) */
  3. /* Version 1.01 (13/01/99)  Modif test clic liaison */
  4. /* Version 1.02 (6/9/99)    Ajout UNLOCK */
  5. /* Version 1.03 (14/04/00)  Adaptation version 2.05 */
  6. /* $VER: 1.03 (© R.Florac, 14/4/00) */
  7. /* Ne teste que les lignes horizontales ou verticales */
  8.  
  9. options results     /* indispensable pour récupérer le résultat des macros */
  10.  
  11. signal on error     /* pour l'interception des erreurs */
  12. signal on syntax
  13.  
  14. 'FIRSTSEL'; i=result
  15. if result~=0 then do
  16.     'NEXTSEL(FIRSTSEL)'
  17.     if result~=0 then i=0
  18. end
  19.  
  20. if i=0 then do
  21.     'PICKOBJ("Cliquez sur la liaison à tester")'
  22.     i=result
  23. end
  24.  
  25. if i<=0 then exit
  26.  
  27. /* Test des liaisons */
  28. j=1; nets=0; net.0=""
  29. 'TITLE("Lecture des liaisons en cours..."):LOCK:OBJECTS'; objets=result
  30.  
  31. /* Initialisation de l'appartenance des objets à une équipotentielle */
  32. net.=-1
  33.  
  34. 'TYPE(O='i')'
  35. if result=2 then do
  36.     'UNMARK(-1):TEST(O)'
  37.     if result=0 then do
  38.     'COORDS(O)'             /* Marquage du fil */
  39.     parse var result x0','y0','x1','y1
  40.     call test_ligne(x0,y0,objets)
  41.     call test_ligne(x1,y1,objets)
  42.     end
  43. end
  44. else do
  45.     'MESSAGE("Sélection incorrecte"):UNLOCK'
  46.     exit
  47. end
  48.  
  49. 'TITLE("Test des jonctions...")'
  50. m=1
  51. do while m>0
  52.     m=0
  53.     i=1
  54.     do while i>0
  55.     'OO=FINDOBJ('i',7,-1,-1)'; i=result
  56.     if i>0 then do
  57.         'TEST(OO)'
  58.         if result=0 then do
  59.         'COL(OO)'; x0=result
  60.         'LINE(OO)'; y0=result
  61.         n=test_jonction(x0,y0,objets)
  62.         if n=1 then do        /* la jonction appartient au net */
  63.            'MARK(OO)'
  64.             call marquer_ligne(x0,y0,objets)
  65.             m=1
  66.         end
  67.         end
  68.         if i=objets then i=0
  69.         else i=i+1
  70.     end
  71.     end
  72. end
  73.  
  74. 'TITLE("Recherche des masses...")'
  75. label=""
  76. do i=1 to objets
  77.     'O=FINDPART('i',"MASSE")'; i=result
  78.     if i>0 then do
  79.     j=connexion_broche(i,1)
  80.     if j>0 then do
  81.         'TEST('j')'
  82.         if result=1 then do
  83.         label=0
  84.         leave i
  85.         end
  86.     end
  87.     i=i+1
  88.     end
  89.     else leave
  90. end
  91.  
  92. if label="" then do
  93.     'TITLE("Recherche des labels...")'
  94.     do i=1 to objets
  95.     'TYPE(O='i')'
  96.     if result=4 | result=12 | result=11 then do
  97.         'ABS(FINDLINE(1,COL(O),LINE(O)))'; j=result
  98.         if j>0 then do
  99.         'TEST('j')'
  100.         if result=1 then do
  101.             'READTEXT(O)'; label=result; leave i
  102.         end
  103.         end
  104.     end
  105.     end
  106. end
  107.  
  108. if label="" then do
  109.     'TITLE("Recherche des alimentations...")'
  110.     do i=1 to objets
  111.     'O=FINDPART('i',"ALIMENTATION")'; i=result
  112.     if i>0 then do
  113.         j=connexion_broche(i,1)
  114.         if j>0 then do
  115.         'TEST('j')'
  116.         if result=1 then do
  117.             'READTEXT(GETVAL(O))'; label=result; leave i
  118.         end
  119.         end
  120.         i=i+1
  121.     end
  122.     else leave
  123.     end
  124. end
  125.  
  126. 'TITLE("")'
  127. if label~="" then 'MESSAGE("Équipotentielle 'label'")'
  128. 'UNLOCK'
  129. exit
  130.  
  131. test_ligne: procedure expose net.
  132.     parse arg x0,y0,objets
  133.     o=1
  134.     do until o=0
  135.     'X=FINDOBJ('o',2,'x0','y0')'; o=result
  136.     if o>0 then do
  137.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  138.         if result~=0 then do
  139.         net.o=1
  140.         parse var result x1','y1','x2','y2
  141.         if x0=x1 & y0=y1 then call test_ligne(x2,y2,objets)
  142.         else call test_ligne(x1,y1,objets)
  143.         end
  144.         if o=objets then return
  145.         o=o+1
  146.     end
  147.     end
  148.     return
  149.  
  150. marquer_ligne: procedure expose net.
  151.     parse arg x0,y0,objets
  152.     o=1
  153.     do until o=0
  154.     'X=ABS(FINDLINE('o','x0','y0'))'; o=result
  155.     if o>0 then do
  156.         'IF(TEST(X),0,MARK(X):COORDS(X))'
  157.         if result~=0 then do
  158.         net.o=1
  159.         parse var result xl','yl','x1','y1
  160.         call test_ligne(xl,yl,objets)
  161.         call test_ligne(x1,y1,objets)
  162.         end
  163.         if o=objets then return
  164.         o=o+1
  165.     end
  166.     end
  167.     return
  168.  
  169. test_jonction: procedure expose net.
  170.     parse arg xj,yj,objets
  171.     obj=1
  172.     do while obj>0
  173.     'X=ABS(FINDLINE('obj','xj','yj'))'; obj=result
  174.     if net.obj=1 then return 1
  175.     if obj=0 then return 0
  176.     if obj=objets then return 0
  177.     obj=obj+1
  178.     end
  179.     return 0
  180.  
  181. connexion_broche: procedure
  182.     parse arg objet,broche
  183.     'PINCOL(O='objet',B='broche')'; xj=result
  184.     'PINLINE(O,B)'; yj=result
  185.     'FINDOBJ(1,2,'xj','yj')'; xl=result     /* Il y a t'il une ligne qui part de la broche? */
  186.     if xl>0 then return xl
  187.     'FINDLINE(1,'xj','yj')'; xl=result      /* Il y a peut être une ligne qui passe SUR la broche... */
  188.     if xl<=0 then return 0
  189.     'FINDOBJ(1,7,'xj','yj')'                /* Il doit alors y avoir une jonction */
  190.     if result>0 then return xl
  191.     return 0
  192.  
  193. /* Traitement des erreurs, interruption du programme */
  194. syntax:
  195. erreur=RC
  196. 'MESSAGE("Erreur de syntaxe"+CHR(10)+"en ligne 'SIGL'"+CHR(10)+"'errortext(erreur)'"):UNLOCK'
  197. exit
  198.  
  199. error:
  200. 'MESSAGE("Erreur en ligne 'SIGL'"):UNLOCK'
  201. exit
  202.